Push the knit button!
library(tidyverse) # contains ggplot2, dplyr, tidyr, etc
library(leaflet)
library(lubridate)
library(plotly)
library(gganimate)
library(viridis)
library(ggthemes)
tuberculosis datasettb <- read_csv(here::here("data/TB_notifications_2020-07-01.csv")) %>%
dplyr::select(country, iso3, year, new_sp_m04:new_sp_fu) %>%
pivot_longer(cols=new_sp_m04:new_sp_fu, names_to="sexage", values_to="count") %>%
mutate(sexage = str_replace(sexage, "new_sp_", "")) %>%
mutate(sex=substr(sexage, 1, 1),
age=substr(sexage, 2, length(sexage))) %>%
dplyr::select(-sexage) %>%
filter(!(age %in% c("04", "014", "514", "u"))) %>%
filter(year > 1996, year < 2013) %>%
mutate(age_group = factor(age,
labels = c("15-24", "25-34", "35-44",
"45-54", "55-64", "65-"))) %>%
dplyr::select(country, year, age_group, sex, count)
# Filter Australia
tb_oz <- tb %>%
filter(country == "Australia")
# Fix names
tb_fixed <- tb %>%
mutate(region=recode(country,
"United States of America"="USA",
"United Kingdom of Great Britain and Northern Ireland"="UK",
"Russian Federation"="Russia",
"Viet Nam"="Vietnam",
"Venezuela (Bolivarian Republic of)"="Venezuela",
"Bolivia (Plurinational State of)"="Bolivia",
"Czechia"="Czech Republic",
"Iran (Islamic Republic of)"="Iran",
"Iran (Islamic Republic of)"="Laos",
"Democratic People's Republic of Korea"="North Korea",
"Republic of Korea"="South Korea",
"United Republic of Tanzania"="Tanzania",
"Congo"="Republic of Congo"))
# Aggregate by year
tb_yearly <- tb_fixed %>%
group_by(year, region) %>%
summarise(count = sum(count))
platypus datasetload(here::here("data/platypus.rda"))
platypus <- platypus %>%
rename(eventDate = `Event Date - parsed`) %>%
filter(!is.na(Latitude), !is.na(Longitude), !is.na(eventDate)) %>%
filter(year(eventDate) > 2018)
platypus %>%
leaflet() %>%
addTiles() %>%
addCircleMarkers(
radius=1, opacity = 0.5, color = "purple", label = ~eventDate,
lat = ~Latitude, lng = ~Longitude)
Remember this code:
tb_action <- highlight_key(tb_oz, ~age_group)
p2 <- ggplot(tb_action, aes(x=year, y=count)) +
geom_line(aes(group=age_group)) +
geom_smooth() +
facet_wrap(~sex)
gg <- ggplotly(p2, height = 300, width = 600) %>%
layout(title = "Click on a line to highlight an age group")
highlight(gg)
Use this plot as the base, and check highlighting still works
p2 <- ggplot(tb_oz, aes(x=year, y=count)) +
geom_line(aes(colour=age_group, group=age_group)) +
facet_wrap(~sex)
p2
This is a bit slow to generate, but give it a go!
tb_yr_map <- world_map %>% left_join(tb_yearly) %>%
filter(year > 2009) %>%
mutate(count = log(count + 1))
ggplot(tb_yr_map, aes(x=long, y=lat, group=group)) +
geom_polygon(aes(fill=count), #<<
color="grey70", size=0.1, na.rm=TRUE) + #<<
expand_limits(x = world_map$long*1.1, y = world_map$lat*1.1) +
scale_fill_viridis("Count (log)") +
theme_map() +
transition_states(year, 3, 1) + #<<
labs(title = "{closest_state}")